home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbfwdp2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-07  |  11.0 KB  |  289 lines
  1. (*===========================================================================*)
  2. (* Ready to go... Start slave task and wait for it to finish.                *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. PROCEDURE do_this_path_part_2(path_common : path_block_ptr);
  10.  
  11.   VAR
  12.     fwd_port  : port_block_ptr;
  13.     i         : BYTE;
  14.     look_port : port_block_ptr;
  15.     look_tcb  : tcb_ptr;
  16.     loop_port : port_block_ptr;
  17.     sav_port  : port_block_ptr;
  18.     this_chan : BYTE;
  19.  
  20.   (*=========================================================================*)
  21.   (* Function to test if it is a BBS                                         *)
  22.   (*=========================================================================*)
  23.  
  24.   FUNCTION test_call_is_bbs : BOOLEAN;
  25.  
  26.     VAR
  27.       uid_i_current : user_index_ptr;
  28.       uid_buffer    : user_record_type;
  29.  
  30.     BEGIN;
  31.  
  32.       test_call_is_bbs := FALSE;
  33.  
  34.       uid_i_current := find_uid(path_common^.path_call);
  35.       IF uid_i_current = NIL THEN
  36.         EXIT;
  37.  
  38.       uid_buffer := get_uid(uid_i_current)^;
  39.       IF ((uid_buffer.user_flag AND (user_f_bbs OR user_f_abbs OR user_f_pbbs))
  40.                                                                       = 0) THEN
  41.         EXIT;
  42.  
  43.       test_call_is_bbs := TRUE;
  44.  
  45.     END; (*----- End of test it is a BBS ------------------------------------*)
  46.  
  47.   (*=========================================================================*)
  48.   (* Function to write message                                               *)
  49.   (*=========================================================================*)
  50.  
  51.   PROCEDURE tell_user;
  52.  
  53.     VAR
  54.       t : STRING[3];
  55.  
  56.     BEGIN;
  57.  
  58.       WITH path_common^ DO
  59.         BEGIN;
  60.           STR(path_msg_count, t);
  61.           window_write(path_write_p,
  62.                        'Forwarding to ' + path_target + ' with '
  63.                                                + t + ' outbound message(s).');
  64.         END;
  65.  
  66.     END;
  67.  
  68.   (*=========================================================================*)
  69.   (* Main line                                                               *)
  70.   (*=========================================================================*)
  71.  
  72.   BEGIN;
  73.  
  74.     WITH path_common^ DO
  75.       BEGIN;
  76.  
  77.         {$IFDEF DEBUG_PORT}
  78.           trace_data('P2 1', 0, active_port, '');
  79.         {$ENDIF}
  80.  
  81.         (*-------------------------------------------------------------------*)
  82.         (* Tell user what happening                                          *)
  83.         (*-------------------------------------------------------------------*)
  84.  
  85.         tell_user;
  86.  
  87.         (*-------------------------------------------------------------------*)
  88.         (* If no sub task then do it!                                        *)
  89.         (*-------------------------------------------------------------------*)
  90.  
  91.         IF NOT path_common^.path_sub_sw THEN
  92.           BEGIN;
  93.  
  94.             {$IFDEF DEBUG_PORT}
  95.               trace_data('P2 2', 0, active_port, '');
  96.             {$ENDIF}
  97.  
  98.             forward_main(path_common);
  99.             EXIT;
  100.           END;
  101.  
  102.         {$IFDEF DEBUG_PORT}
  103.           trace_data('P2 3', 0, active_port, '');
  104.         {$ENDIF}
  105.  
  106.         (*-------------------------------------------------------------------*)
  107.         (* Make sure we don't have a duplicate connect!                      *)
  108.         (*-------------------------------------------------------------------*)
  109.  
  110.         IF opt_block.opt_already_conn THEN
  111.           BEGIN;
  112.  
  113.             look_tcb := active_tcb^.next_tcb;
  114.             WHILE look_tcb <> active_tcb DO
  115.               IF (look_tcb^.tcb_type = th_user)
  116.                              AND (path_call = look_tcb^.uid_data.user_id) THEN
  117.                 BEGIN;
  118.                   window_write(path_write_p,
  119.                                path_target + '(' + path_call +
  120.                                + ') connected on another channel.  Skipping');
  121.                   EXIT;
  122.                 END
  123.               ELSE
  124.                 look_tcb := look_tcb^.next_tcb;
  125.  
  126.           END;
  127.  
  128.         (*-------------------------------------------------------------------*)
  129.         (* Make sure we have a bbs target                                    *)
  130.         (*-------------------------------------------------------------------*)
  131.  
  132.         IF NOT test_call_is_bbs THEN
  133.           BEGIN;
  134.  
  135.             window_write(path_write_p,
  136.                          path_target + '(' + path_call +
  137.                                      + ') is not a BBS.  Skipping');
  138.             EXIT;
  139.           END;
  140.  
  141.         (*-------------------------------------------------------------------*)
  142.         (* Handle forward to a file                                          *)
  143.         (*-------------------------------------------------------------------*)
  144.  
  145.         IF path_port[1] = 'L' THEN
  146.           BEGIN;
  147.             path_info := COPY(path_info, 2, 255);
  148.             strip_var(path_info, 'B');
  149.             upcase_str_var(path_info);
  150.             export_cmd('E ' + path_info, path_common);
  151.             path_did_all := TRUE;
  152.             EXIT;
  153.           END;
  154.  
  155.         (*-------------------------------------------------------------------*)
  156.         (* Find the port wanted                                              *)
  157.         (*-------------------------------------------------------------------*)
  158.  
  159.         fwd_port := find_port_addr(path_port[1]);
  160.  
  161.         IF fwd_port = NIL THEN
  162.           BEGIN;
  163.             window_write(path_write_p,
  164.                          'Port ' + path_port + ' for ' + path_target
  165.                                              + ' does not exist!');
  166.             EXIT;
  167.           END;
  168.  
  169.         (*-------------------------------------------------------------------*)
  170.         (* If port is locked then tell him and hang up                       *)
  171.         (*-------------------------------------------------------------------*)
  172.  
  173.         IF fwd_port^.port_operate_mode.mode_stop_fwd
  174.                                    OR opt_block.operate_mode.mode_stop_fwd THEN
  175.           BEGIN;
  176.             window_write(path_write_p,
  177.                          'Sysop has locked out forwarding on port '
  178.                                                                   + path_port);
  179.             EXIT;
  180.           END;
  181.  
  182.         (*-------------------------------------------------------------------*)
  183.         (* If user requests, make sure TNC is free                           *)
  184.         (*-------------------------------------------------------------------*)
  185.  
  186.         IF fwd_port^.port_no_busy_fwd THEN
  187.           BEGIN;
  188.  
  189.             FOR i := 1 TO fwd_port^.max_chan DO
  190.               BEGIN;
  191.                 look_tcb := fwd_port^.connected^[i];
  192.                 IF (i <> this_chan)
  193.                         AND (look_tcb <> NIL)
  194.                         AND ((fwd_port^.port_type <> port_pcpa)
  195.                                       OR (look_tcb^.tcb_port = fwd_port)) THEN
  196.                   BEGIN;
  197.                     window_write(path_write_p,
  198.                                  'Port ' + path_port + ' is busy');
  199.                     window_write(path_write_p,
  200.                                  ' User is ' + look_tcb^.port_chan_s
  201.                                  + ' ' + look_tcb^.tcb_name);
  202.                     EXIT;
  203.                   END;
  204.               END;
  205.  
  206.           END;
  207.  
  208.         (*-------------------------------------------------------------------*)
  209.         (* Set the channel                                                   *)
  210.         (*-------------------------------------------------------------------*)
  211.  
  212.         IF (fwd_port^.port_type <> port_modem)
  213.                               AND (fwd_port^.port_type <> port_null_modem) THEN
  214.           BEGIN;
  215.             this_chan := fwd_port^.max_conn;
  216.             IF NOT fwd_port^.port_no_busy_fwd THEN
  217.               INC(this_chan);
  218.           END
  219.         ELSE
  220.           this_chan := 1;
  221.  
  222.         (*-------------------------------------------------------------------*)
  223.         (* Make sure channel is free                                         *)
  224.         (*-------------------------------------------------------------------*)
  225.  
  226.         IF fwd_port^.connected^[this_chan] <> NIL THEN
  227.           BEGIN;
  228.  
  229.             window_write(path_write_p,
  230.                          'Port ' + path_port + ' forward channel is busy');
  231.  
  232.             look_tcb := fwd_port^.connected^[this_chan];
  233.             window_write('FO::', 'User is '
  234.                            + look_tcb^.port_chan_s + ' ' + look_tcb^.tcb_name);
  235.  
  236.             EXIT;
  237.           END;
  238.  
  239.         (*-------------------------------------------------------------------*)
  240.         (* Start the new task                                                *)
  241.         (*-------------------------------------------------------------------*)
  242.  
  243.         active_tcb^.channel := this_chan;
  244.  
  245.         active_tcb^.port_chan_s := fwd_port^.port_char
  246.                                                      + byte_to_char[this_chan];
  247.  
  248.         sav_port             := active_port;
  249.         active_port          := fwd_port;
  250.         active_tcb^.tcb_port := fwd_port;
  251.  
  252.         path_common_temp := path_common;
  253.         fwd_slave_tcb := task_create(@forward_to_remote,
  254.                                                         forwardsub_stack_size);
  255.  
  256.         (*-------------------------------------------------------------------*)
  257.         (* Restore things                                                    *)
  258.         (*-------------------------------------------------------------------*)
  259.  
  260.         active_port             := sav_port;
  261.         active_tcb^.tcb_port    := sav_port;
  262.         active_tcb^.port_chan_s := 'FO';
  263.  
  264.         (*-------------------------------------------------------------------*)
  265.         (* Give error message                                                *)
  266.         (*-------------------------------------------------------------------*)
  267.  
  268.         IF fwd_slave_tcb = NIL THEN
  269.           BEGIN;
  270.             window_write(path_write_p, 'Out of tasks for forward');
  271.             EXIT;
  272.           END;
  273.  
  274.         (*-------------------------------------------------------------------*)
  275.         (* Move the path msg data array to this task                         *)
  276.         (*-------------------------------------------------------------------*)
  277.  
  278.         move_task_mem(path_block_mem_id, active_tcb, fwd_slave_tcb);
  279.  
  280.         (*-------------------------------------------------------------------*)
  281.         (* Wait for completion of its work                                   *)
  282.         (*-------------------------------------------------------------------*)
  283.  
  284.         wait_for_dead_task(fwd_slave_tcb);
  285.  
  286.       END;
  287.  
  288.   END;
  289.